VERSION 5.00
Begin VB.UserControl Button 
   AutoRedraw      =   -1  'True
   ClientHeight    =   1095
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1095
   MaskColor       =   &H00FF00FF&
   PropertyPages   =   "Button.ctx":0000
   ScaleHeight     =   73
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   73
   ToolboxBitmap   =   "Button.ctx":0035
   Begin VB.Timer tmrTimer 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   0
      Top             =   0
   End
   Begin VB.PictureBox picImg 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   615
      Left            =   240
      ScaleHeight     =   41
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   41
      TabIndex        =   0
      Top             =   240
      Visible         =   0   'False
      Width           =   615
   End
End
Attribute VB_Name = "Button"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Private type
Private Type POINTAPI
    X As Long
    Y As Long
End Type

'Protected enum
Enum BTextAlign
    [taLeft]
    [taCenter]
    [taRight]
End Enum

Enum BPictureAlign
    [paLeft]
    [paCenter]
    [paRight]
End Enum

Enum BDisplay
    [TextOnly]
    [ImageOnly]
    [TextAndImage]
End Enum

'Windows api
Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint _
                Lib "user32" (ByVal xPoint As Long, _
                              ByVal yPoint As Long) As Long
Private Declare Function TransparentBlt _
                Lib "msimg32" (ByVal hDC As Long, _
                               ByVal X As Long, _
                               ByVal Y As Long, _
                               ByVal nWidth As Long, _
                               ByVal nHeight As Long, _
                               ByVal hSrcDC As Long, _
                               ByVal xSrc As Long, _
                               ByVal ySrc As Long, _
                               ByVal nSrcWidth As Long, _
                               ByVal nSrcHeight As Long, _
                               ByVal crTransparent As Long) As Long
Private Declare Function TextOut _
                Lib "gdi32" _
                Alias "TextOutA" (ByVal hDC As Long, _
                                  ByVal X As Long, _
                                  ByVal Y As Long, _
                                  ByVal lpString As String, _
                                  ByVal nCount As Long) As Long
Private Declare Function lstrlen _
                Lib "kernel32" _
                Alias "lstrlenA" (ByVal lpString As String) As Long

'Private variables
Private pt                 As POINTAPI

Private m_MouseIn          As Boolean
Private m_MouseDown        As Boolean
Private m_GotFocus         As Boolean
Private m_ShowFocus        As Boolean

Private m_BackColor        As OLE_COLOR
Private m_BackColorHover   As OLE_COLOR
Private m_BackColorPress   As OLE_COLOR
Private m_BorderColor      As OLE_COLOR
Private m_BorderColorHover As OLE_COLOR
Private m_BorderColorPress As OLE_COLOR
Private m_Caption          As String
Private m_Display          As BDisplay
Private m_PictureAlign     As BPictureAlign
Private m_TextColor        As OLE_COLOR
Private m_TextColorHover   As OLE_COLOR
Private m_TextColorPress   As OLE_COLOR
Private m_TxtAlign         As BTextAlign
Private m_MouseButton      As MouseButtonConstants

'Event Declarations:
Event Click()
Event DblClick()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseEnter()
Event MouseLeave()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)

' *********************************************************************************
' PROPERTIES
' *********************************************************************************

Public Property Get BackColor() As OLE_COLOR
    BackColor = m_BackColor
End Property

Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
    m_BackColor = vNewValue
    Call DrawButton
    PropertyChanged "BackColor"
End Property

Public Property Get BackColorHover() As OLE_COLOR
    BackColorHover = m_BackColorHover
End Property

Public Property Let BackColorHover(ByVal vNewValue As OLE_COLOR)
    m_BackColorHover = vNewValue
    Call DrawButton
    PropertyChanged "BackColorHover"
End Property

Public Property Get BackColorPress() As OLE_COLOR
    BackColorPress = m_BackColorPress
End Property

Public Property Let BackColorPress(ByVal vNewValue As OLE_COLOR)
    m_BackColorPress = vNewValue
    Call DrawButton
    PropertyChanged "BackColorPress"
End Property

Public Property Get BorderColor() As OLE_COLOR
    BorderColor = m_BorderColor
End Property

Public Property Let BorderColor(ByVal vNewValue As OLE_COLOR)
    m_BorderColor = vNewValue
    Call DrawButton
    PropertyChanged "BorderColor"
End Property

Public Property Get BorderColorHover() As OLE_COLOR
    BorderColorHover = m_BorderColorHover
End Property

Public Property Let BorderColorHover(ByVal vNewValue As OLE_COLOR)
    m_BorderColorHover = vNewValue
    Call DrawButton
    PropertyChanged "BorderHover"
End Property

Public Property Get BorderColorPress() As OLE_COLOR
    BorderColorPress = m_BorderColorPress
End Property

Public Property Let BorderColorPress(ByVal vNewValue As OLE_COLOR)
    m_BorderColorPress = vNewValue
    Call DrawButton
    PropertyChanged "BorderColorPress"
End Property

Public Property Get Caption() As String
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal vNewValue As String)
    m_Caption = vNewValue
    Call DrawButton
    PropertyChanged "Caption"
End Property

Public Property Get Display() As BDisplay
    Display = m_Display
End Property

Public Property Let Display(ByVal vNewValue As BDisplay)
    m_Display = vNewValue
    Call DrawButton
    PropertyChanged "Display"
End Property

Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(New_Value As Boolean)
    Static EnabledColor As OLE_COLOR
    UserControl.Enabled = New_Value

    If New_Value = True Then
        m_TextColor = EnabledColor
    Else
        EnabledColor = m_TextColor
        m_TextColor = &HB3B3B3
    End If
    Call DrawButton
    UserControl.Refresh
    PropertyChanged "Enabled"
End Property

Public Property Get Font() As Font
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set UserControl.Font = New_Font
    Call DrawButton
    PropertyChanged "Font"
End Property

Public Property Get MouseIcon() As Picture
    Set MouseIcon = UserControl.MouseIcon
End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set UserControl.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property

Public Property Get MousePointer() As MousePointerConstants
    MousePointer = UserControl.MousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer As MousePointerConstants)

    If New_MousePointer < vbDefault Then New_MousePointer = vbDefault
    If (New_MousePointer > vbSizeAll) And (New_MousePointer <> vbCustom) Then New_MousePointer = vbSizeAll
    UserControl.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
End Property

Public Property Get Picture() As Picture
    Set Picture = picImg.Picture
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
    Set picImg.Picture = New_Picture
    Call DrawButton
    PropertyChanged "Picture"
End Property

Public Property Get PictureAlign() As BPictureAlign
    PictureAlign = m_PictureAlign
End Property

Public Property Let PictureAlign(ByVal vNewValue As BPictureAlign)
    m_PictureAlign = vNewValue
    Call DrawButton
    PropertyChanged "PictureAlign"
End Property

Public Property Get ShowFocusRect() As Boolean
    ShowFocusRect = m_ShowFocus
End Property

Public Property Let ShowFocusRect(ByVal vNewValue As Boolean)
    m_ShowFocus = vNewValue
    Call DrawButton
    PropertyChanged "ShowFocusRect"
End Property

Public Property Get TextAlign() As BTextAlign
    TextAlign = m_TxtAlign
End Property

Public Property Let TextAlign(ByVal vNewValue As BTextAlign)
    m_TxtAlign = vNewValue
    Call DrawButton
    PropertyChanged "TextAlign"
End Property

Public Property Get TextColor() As OLE_COLOR
    TextColor = m_TextColor
End Property

Public Property Let TextColor(ByVal vNewValue As OLE_COLOR)
    m_TextColor = vNewValue
    Call DrawButton
    PropertyChanged "TextColor"
End Property

Public Property Get TextColorPress() As OLE_COLOR
    TextColorPress = m_TextColorPress
End Property

Public Property Let TextColorPress(ByVal vNewValue As OLE_COLOR)
    m_TextColorPress = vNewValue
    Call DrawButton
    PropertyChanged "TextColorPress"
End Property

Public Property Get TextColorHover() As OLE_COLOR
    TextColorHover = m_TextColorHover
End Property

Public Property Let TextColorHover(ByVal vNewValue As OLE_COLOR)
    m_TextColorHover = vNewValue
    Call DrawButton
    PropertyChanged "TextColorHover"
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    BackColor = PropBag.ReadProperty("BackColor", &HF0ECEC)
    BackColorHover = PropBag.ReadProperty("BackColorHover", &HF5DEC9)
    BackColorPress = PropBag.ReadProperty("BackColorPress", &HCC7A00)
    BorderColor = PropBag.ReadProperty("BorderColor", &HACACAC)
    BorderColorHover = PropBag.ReadProperty("BorderColorHover", &HFF9933)
    BorderColorPress = PropBag.ReadProperty("BorderColorPress", &HCC7A00)
    Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
    Display = PropBag.ReadProperty("Display", TextOnly)
    Enabled = PropBag.ReadProperty("Enabled", True)
    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", vbDefault)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    PictureAlign = PropBag.ReadProperty("PictureAlign", paCenter)
    ShowFocusRect = PropBag.ReadProperty("ShowFocusRect", False)
    TextAlign = PropBag.ReadProperty("TextAlign", taCenter)
    TextColor = PropBag.ReadProperty("TextColor", vbBlack)
    TextColorHover = PropBag.ReadProperty("TextColorHover", vbBlack)
    TextColorPress = PropBag.ReadProperty("TextColorPress", vbWhite)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("BackColor", m_BackColor, &HF0ECEC)
    Call PropBag.WriteProperty("BackColorHover", m_BackColorHover, &HF5DEC9)
    Call PropBag.WriteProperty("BackColorPress", m_BackColorPress, &HCC7A00)
    Call PropBag.WriteProperty("BorderColor", m_BorderColor, &HACACAC)
    Call PropBag.WriteProperty("BorderColorHover", m_BorderColorHover, &HFF9933)
    Call PropBag.WriteProperty("BorderColorPress", m_BorderColorPress, &HCC7A00)
    Call PropBag.WriteProperty("Caption", m_Caption, Ambient.DisplayName)
    Call PropBag.WriteProperty("Display", m_Display, TextOnly)
    Call PropBag.WriteProperty("Enabled", Enabled, True)
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, vbDefault)
    Call PropBag.WriteProperty("Picture", Picture, Nothing)
    Call PropBag.WriteProperty("PictureAlign", m_PictureAlign, paCenter)
    Call PropBag.WriteProperty("ShowFocusRect", m_ShowFocus, False)
    Call PropBag.WriteProperty("TextAlign", m_TxtAlign, paCenter)
    Call PropBag.WriteProperty("TextColor", m_TextColor, vbBlack)
    Call PropBag.WriteProperty("TextColorHover", m_TextColorHover, vbBlack)
    Call PropBag.WriteProperty("TextColorPress", m_TextColorPress, vbWhite)
End Sub

' *********************************************************************************
' FUNCTION
' *********************************************************************************

Public Property Get hwnd() As Long
    hwnd = UserControl.hwnd
End Property

Public Sub Clean()
    picImg.Picture = LoadPicture("")
    Call Refresh
End Sub

Public Sub Refresh()
    picImg.Refresh
    Call DrawButton
    UserControl.Refresh
End Sub

' *********************************************************************************
' USER CONTROL
' *********************************************************************************

Private Sub UserControl_Click()

    If m_MouseButton = vbLeftButton Then
        RaiseEvent Click
    End If
End Sub

Private Sub UserControl_DblClick()

    If m_MouseButton = vbLeftButton Then
        RaiseEvent DblClick
    End If
End Sub

Private Sub UserControl_EnterFocus()
    m_GotFocus = True
    Call DrawButton
End Sub

Private Sub UserControl_ExitFocus()
    m_GotFocus = False
    Call DrawButton
End Sub

Private Sub UserControl_MouseDown(Button As Integer, _
                                  Shift As Integer, _
                                  X As Single, _
                                  Y As Single)
    m_MouseButton = Button

    If Button = vbLeftButton Then
        m_MouseDown = True
        Call DrawButton
    End If
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, _
                                  Shift As Integer, _
                                  X As Single, _
                                  Y As Single)

    If (X >= 0 And Y >= 0) And (X < UserControl.ScaleWidth And Y < UserControl.ScaleHeight) Then
        tmrTimer.Enabled = True
        m_MouseIn = True
        RaiseEvent MouseEnter
        Call DrawButton
    End If
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, _
                                Shift As Integer, _
                                X As Single, _
                                Y As Single)
    m_MouseDown = False
    Call DrawButton
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_Resize()
    On Error Resume Next

    If UserControl.Width < 255 Then UserControl.Width = 255
    If UserControl.Height < 255 Then UserControl.Height = 255
    Call DrawButton
End Sub

Private Sub UserControl_Show()
    Call DrawButton
End Sub

Private Sub UserControl_InitProperties()
    BackColor = &HF0ECEC
    BackColorHover = &HF5DEC9
    BackColorPress = &HCC7A00
    BorderColor = &HACACAC
    BorderColorHover = &HFF9933
    BorderColorPress = &HCC7A00
    Caption = Ambient.DisplayName
    Display = TextOnly
    Enabled = True
    Set UserControl.Font = Ambient.Font
    PictureAlign = paCenter
    ShowFocusRect = False
    TextAlign = taCenter
    TextColor = vbBlack
    TextColorHover = vbBlack
    TextColorPress = vbWhite
End Sub

' *********************************************************************************
' CUSTOM ROUTINES
' *********************************************************************************

Private Sub DrawButton()
    Dim ImgWidth As Integer, ImgHeight As Integer
    Dim ImgPosX  As Integer, ImgPosY As Integer

    With UserControl
        .Cls
        
        ImgWidth = picImg.ScaleWidth
        ImgHeight = picImg.ScaleHeight
        
        If m_MouseIn Then
            If m_MouseDown Then
                .BackColor = BackColorPress
                .ForeColor = TextColorPress
                UserControl.Line (0, 0)-(.ScaleWidth - 1, .ScaleHeight - 1), BorderColorPress, B
            Else
                'Do hover color
                .BackColor = BackColorHover
                .ForeColor = TextColorHover
                UserControl.Line (0, 0)-(.ScaleWidth - 1, .ScaleHeight - 1), BorderColorHover, B
            End If
        Else
            .BackColor = BackColor
            .ForeColor = TextColor
            'Draw border
            UserControl.Line (0, 0)-(.ScaleWidth - 1, .ScaleHeight - 1), BorderColor, B
        End If
        
        If m_GotFocus And ShowFocusRect And Not m_MouseDown Then
            .DrawWidth = 3
            UserControl.Line (0, 0)-(.ScaleWidth - 1, .ScaleHeight - 1), BorderColorHover, B
            .DrawWidth = 1
        End If
        
        'Position image
        Select Case PictureAlign

            Case paLeft
                ImgPosX = 4
                ImgPosY = (.ScaleHeight - ImgHeight) / 2

            Case paCenter
                ImgPosX = (.ScaleWidth - ImgWidth) / 2
                ImgPosY = (.ScaleHeight - ImgHeight) / 2

            Case paRight
                ImgPosX = (.ScaleWidth - ImgWidth - 4)
                ImgPosY = (.ScaleHeight - ImgHeight) / 2
        End Select
        
        If Display = ImageOnly Or Display = TextAndImage Then
            TransparentBlt .hDC, ImgPosX, ImgPosY, ImgWidth, ImgHeight, picImg.hDC, 0, 0, ImgWidth, ImgHeight, vbMagenta
        End If
        
        If (Display = TextOnly) Or (Display = TextAndImage) Then

            Select Case TextAlign

                Case taLeft
                    .CurrentX = 4
                    .CurrentY = (.ScaleHeight - .TextHeight(Caption)) / 2

                Case taCenter
                    .CurrentX = (.ScaleWidth - .TextWidth(Caption)) / 2
                    .CurrentY = (.ScaleHeight - .TextHeight(Caption)) / 2

                Case taRight
                    .CurrentX = (.ScaleWidth - .TextWidth(Caption) - 4)
                    .CurrentY = (.ScaleHeight - .TextHeight(Caption)) / 2
            End Select
            
            TextOut .hDC, .CurrentX, .CurrentY, Caption, lstrlen(Caption)
        End If
    End With
End Sub

Private Sub tmrTimer_Timer()
    Dim iHwnd As Long
    
    GetCursorPos pt
    iHwnd = WindowFromPoint(pt.X, pt.Y)
    
    If iHwnd <> UserControl.hwnd Then
        tmrTimer.Enabled = False
        m_MouseIn = False
        RaiseEvent MouseLeave
        Call DrawButton
    End If
End Sub
